home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip: 2001 Haziran
/
CHIP Haziran2001.iso
/
prog
/
share
/
04
/
setup.exe
/
MM7.Cab
/
F441_ado.info5.asp.3A7A5E73_1F50_4F88_AB38_531BFA72E747
next >
Wrap
Text File
|
2000-08-17
|
9KB
|
322 lines
<!-- #INCLUDE FILE="../include/utils.runtime5.asp" -->
<!-- #INCLUDE FILE="../include/ado.runtime5.asp" -->
<script runat="server" language="VBScript">
' *****************************************************************************
'
' info/ado.info5.asp
'
' Dynamic Link design time support for Microsoft ADO.
'
'
' COPYRIGHT (c) 1999-2000 Adobe Systems Incorporated. All rights reserved.
' -----------------------------------------------------------------------------
' Return an XML document containing information about the databases
' in ../databases. Valid requests are:
'
' ado.info5.asp return the available databases
' ex) http://localhost/golive/config/info/ado.info5.asp
' ado.info5.asp?db=<name> return schema information about a given database
' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine
RejectUnauthorizedCallers
Response.ContentType = "text/xml"
if False = RuntimeDebug then
on error resume next
end if
if IsEmpty(Request("db")) then
WriteDatabases
else
WriteDatabaseSchema Request("db")
end if
if Err then
WriteError
end if
' -----------------------------------------------------------------------------
' Write out the list of available databases. XML format:
'
' <DATABASES>
' [<DATABASE>...]*
function WriteDatabases
dim fileSystem
dim folder
dim file
dim fileName
dim prevFileName
set fileSystem = CreateObject("Scripting.FileSystemObject")
set folder = fileSystem.GetFolder(GetDatabasePath())
Response.Write "<DATABASES>" & vbNewLine
for each file in folder.files
select case ucase(fileSystem.GetExtensionName(file))
case "UDL", "DSN", "MDB", "XDB"
fileName = fileSystem.GetBaseName(file)
if fileName <> prevFileName then
Response.Write " <DATABASE>" & fileName & "</DATABASE>" & vbNewLine
prevFileName = fileName
end if
end select
next
Response.Write "</DATABASES>" & vbNewLine
end function
' -----------------------------------------------------------------------------
' Write out the schema for a given database. XML format is either:
' 1. no types or sql parameters
' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine
' <DATATYPES>
' [<DATATYPE>
' <TYPE_NAME>...
' <DATA_TYPE>...
' <IS_LONG>...
' <SEARCHABLE>...
' <LITERAL_PREFIX>...
' <LITERAL_SUFFIX>...]*
'
' 2. types parameter is * or comma-delimited list of table types to return
' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine&types=*
' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine&types=table,view
' <TABLES>
' [<TABLE>...]*
'
' 3. sql parameter gives a query but there is no records parameter
' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine&sql=select%20*%20from%20Projects
' <COLUMNS>
' [<COLUMN>
' <COLUMN_NAME>...
' <DATA_TYPE>...
' <ATTRIBUTES>...]*
'
' 4. records parameter is present (actual data, not schema information)
' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine&sql=select%20*%20from%20Projects&records=0
' <ROWSET>
' [<ROW>
' [<fieldname>fieldvalue</fieldname>]*]*
' 5. keys parameter is primary key field
' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine&keys=Projects
' <KEYS>
' [<PRIMAY_KEY>....
function WriteDatabaseSchema(db)
dim connection
set connection = CreateObject("ADODB.Connection")
connection.Open ConnectString(db)
if IsEmpty(Request("sql")) then
DoOpenSchema connection
else
AnalyzeRecordset connection.Execute(Request("sql"))
end if
end function
' -----------------------------------------------------------------------------
' Handles schema requests that need OpenSchema
function DoOpenSchema(connection)
if IsEmpty(Request("keys")) then
if IsEmpty(Request("types")) then
OpenTypesSchema connection
else
OpenTablesSchema connection, Request("types")
end if
else
OpenKeysSchema connection, Request("keys")
end if
end function
' -----------------------------------------------------------------------------
' Get provider types
function OpenTypesSchema(connection)
dim datatypes, typefields, field
typefields = Array("TYPE_NAME", "DATA_TYPE", "IS_LONG", "SEARCHABLE", "LITERAL_PREFIX", "LITERAL_SUFFIX")
set datatypes = connection.OpenSchema(adSchemaProviderTypes)
Response.Write "<DATATYPES>" & vbNewLine
while not datatypes.EOF
dim typefield
Response.Write " <DATATYPE>" & vbNewLine
for each typefield in typefields
set field = datatypes(typefield)
value = field.Value
if value = "null" then value = ""
Response.Write " <" & field.Name & ">" & value & "</" & field.Name & ">" & vbNewLine
next
Response.Write " </DATATYPE>" & vbNewLine
datatypes.MoveNext
wend
Response.Write "</DATATYPES>" & vbNewLine
end function
' -----------------------------------------------------------------------------
' Get primary key fields
function OpenKeysSchema(connection, keys)
dim catalog, index
tableName = keys
set catalog = CreateObject("ADOX.Catalog")
set catalog.ActiveConnection = connection
Response.Write "<KEYS>" & vbNewLine
for each index in catalog.Tables( tableName ).Indexes
if False = testIndexColumns( index ) then
exit for
end if
if index.PrimaryKey = True then
for i = 0 to index.Columns.Count - 1
Response.Write " <PRIMARY_KEY>" & index.Columns(i).Name & "</PRIMARY_KEY>" & vbNewLine
next
end if
next
Response.Write "</KEYS>" & vbNewLine
end function
' -----------------------------------------------------------------------------
' Get table names
function OpenTablesSchema(connection, typesString)
dim tables
if typesString = "*" then
set tables = connection.OpenSchema(adSchemaTables)
Response.Write "<TABLES>" & vbNewLine
while not tables.EOF
Response.Write " <TABLE>" & tables("TABLE_NAME") & "</TABLE>" & vbNewLine
tables.MoveNext
wend
Response.Write "</TABLES>" & vbNewLine
else
dim types, weparse, i, j
weparse = False
types = Split(typesString, ",")
Response.Write "<TABLES>" & vbNewLine
on error resume next
for i = LBound(types) to UBound(types)
set tables = connection.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, types(i)))
if Err then
we parse = True
exit for
end if
while not tables.EOF
Response.Write " <TABLE>" & tables("TABLE_NAME") & "</TABLE>" & vbNewLine
tables.MoveNext
wend
next
if weparse then
set tables = connection.OpenSchema(adSchemaTables)
while not tables.EOF
for j = i to UBound(types)
if types(j) = tables("TABLE_TYPE") then
Response.Write " <TABLE>" & tables("TABLE_NAME") & "</TABLE>" & vbNewLine
end if
next
tables.MoveNext
wend
end if
Response.Write "</TABLES>" & vbNewLine
end if
end function
' -----------------------------------------------------------------------------
' Handles schema requests from recordsets
function AnalyzeRecordset(rs)
dim fields, field, recordsString
set fields = rs.Fields
recordsString = Request("records")
if IsEmpty(recordsString) then
dim i
Response.Write "<COLUMNS>" & vbNewLine
for i = 0 to fields.Count - 1
set field = fields(i)
Response.Write " <COLUMN>" & vbNewLine
Response.Write " <COLUMN_NAME>" & field.Name & "</COLUMN_NAME>" & vbNewLine
Response.Write " <DATA_TYPE>" & field.Type & "</DATA_TYPE>" & vbNewLine
Response.Write " <ATTRIBUTES>" & field.Attributes & "</ATTRIBUTES>" & vbNewLine
Response.Write " </COLUMN>" & vbNewLine
next
Response.Write "</COLUMNS>" & vbNewLine
else
dim records
records = split(recordsString, ",")
rs.Move records(0)
Response.Write "<ROWSET>" & vbNewLine
do
Response.Write " <ROW>" & vbNewLine
for i = 0 to fields.Count - 1
set field = fields(i)
Response.Write " <" & field.Name & ">" & field.Value & "</" & field.Name & ">" & vbNewLine
next
Response.Write " </ROW>" & vbNewLine
if CLng(records(0)) >= CLng(records(ubound(records))) then exit do
records(0) = records(0) + 1
rs.MoveNext
loop while not (rs.EOF or Err)
Response.Write "</ROWSET>" & vbNewLine
end if
end function
' -----------------------------------------------------------------------------
' Write out an error message as XML.
function WriteError
dim qt
qt = chr(34)
Response.Write "<ERROR"
Response.Write " Number=" & qt & Err.Number & qt
Response.Write " Source=" & qt & Err.Source & qt
Response.Write " Description=" & qt & Err.Description & qt
Response.Write " HelpFile=" & qt & Err.HelpFile & qt
Response.Write " HelpContext=" & qt & Err.HelpContext & qt
Response.Write "/>" & vbNewLine
end function
</script>